#! /usr/bin/perl

use strict;

##################
# Import modules #
##################

#use Proc::Daemon;
use MIME::Base64;
use LWP;
use LWP::UserAgent;
use XML::Simple;
use Encode;
use Date::Parse;
use Date::Format;
use Data::Dumper;




#######################
# Global declarations #
#######################

# Forward declarations
sub start ();
sub stop ();
sub clean ();
sub output (@);
sub print_log (@);

sub pid_read ();
sub pid_write ();
sub pid_clean ();
sub pid_kill ();

sub task_clean (\%);
sub task_run (\%);

# Global variables
my $appname = 'conky-gtools';
my $basedir = $ENV{'HOME'}.'/.'.$appname;
my $rcfile  = $basedir."/conky-gtools.rc";
my $pidfile = $basedir.'/'.$appname.'.pid';
my $logfile = $basedir.'/'.$appname.'.log';
my $pid = 0;
my $die_expected = 0;

# Default values for user prefs
our %conky = ();

$conky{'GMail'} = {
    "action" => \&gmail_run,
    "clean"  => \&gmail_clean,
    "next"   => -1,
    "active" => 1,
    "period" => 300,
    "lines"  => 10,
    "chars"  => 100
    };

$conky{'GCal'} = {
    "action" => \&gcal_run,
    "clean"  => \&gcal_clean,
    "next"   => -1,
    "active" => 1,
    "period" => 600,
    "lines"  => 10,
    "chars"  => 100
    };




#####################
# General functions #
#####################

# Determine command line arguments and run appropriate actions
my $action = shift || "start";
if ($action eq "clean")
{
    clean;
    $die_expected = 1;
    exit 0;
}
elsif ($action eq "stop")
{
    stop;
    clean;
    $die_expected = 1;
    exit 0;
}
elsif ($action eq "start")
{
    start;
    $die_expected = 1;
    exit 0;
}
elsif ($action eq "restart")
{
    stop;
    start;
    $die_expected = 1;
    exit 0;
}
else
{
    $die_expected = 1;
    die "Unrecognized command: `$action'\n";
}


# Put conky-gtools in a clean and usable state:
#  - create config directory if it doesn't exist
#  - load user preference settings
#  - clean conky-gtools generated files
sub clean ()
{
    unless (-d $basedir)
    {
        print STDERR "Creating directory `$basedir'.\n";
        mkdir $basedir;
        chmod 0700, $basedir;
        print_log "NN: Created directory `$basedir'.\n";
    }
    do $rcfile;    

    print_log "NN: Cleaning generated files\n";
    task_clean %conky;
}

# Start the daemon
sub start ()
{
    $pid = pid_read;
    if ($pid != 0)
    {
        $die_expected = 1;
        die "Another $appname process is already running [$pid]\n";
    }

    clean;

    print_log "NN: Starting daemon\n";
    $pid = pid_write;
    
    # Do some cleaning before exiting
    $SIG{TERM} = $SIG{INT} = $SIG{QUIT} = sub
    {
        print_log "NN: Caught signal. Exiting nicely...\n";
        pid_clean;
        task_clean %conky;
        $die_expected = 1;
        exit 0;
    };

    # Run periodic tasks;
    task_run %conky;
}

# Kill any already running conky-gtools instance
sub stop ()
{
    pid_kill;
}

# Try to handle unexpected termination
END
{
    unless ($die_expected)
    {
        print_log "EE: Unexpected termination. Trying to clean-up anyway...\n";
        pid_clean;
        task_clean %conky;
        exit 1;
    }
}

# Output to a conky file
sub output (@)
{
    my $name = shift;
    my $num  = shift;
    my $file = $basedir.'/'.$name.'.'.$num;
    
    unless (open OUT, ">". $file)
    {
        print_log "EE: Could not open output file `$file': $!\n";
        exit 1;
    }
    print OUT @_;
    close OUT;
}

# Log
sub print_log (@)
{
    unless (open LOG, ">>".$logfile)
    {
        print STDERR "EE: Could not open log file `$logfile': $!\n";
        exit 2;
    }
    print LOG
        time2str ("%Y/%m/%d %H:%M:%S", time), " ",
        $appname, "[", $$, "] ",
        @_;
    close LOG;
}




######################
# PID files handling #
######################

# Remove an existing PID file
sub pid_remove ()
{
    print_log "NN: Removing PID file.\n";
    unlink $pidfile;
}

# Do some cleaning before exiting
sub pid_clean ()
{
    pid_remove if $pid == $$;
}

# Read the PID file and check whether the process is alive
sub pid_read ()
{
    unless (-e $pidfile)
    {
        return 0;
    }

    open PID, "<".$pidfile
        or die "Could not open PID file `$pidfile' for reading: $!\n";
    my $p = <PID>; chomp $p;
    close PID;

    if (kill 0, $p)
    {
        return $p;
    }

    pid_remove;
    return 0;
}

# Write our PID to the PID file
sub pid_write ()
{
    unless (open PID, ">".$pidfile)
    {
        print_log "EE: Could not open PID file `$pidfile' for writing: $!\n";
        exit 3;
    }
    print PID $$, "\n";
    close PID;

    return $$;
}

# Kill a running process
sub pid_kill ()
{
    my $action = 0;
    $pid = pid_read;
    while ($pid != 0)
    {
        if ($action == 0)
        {
            print STDERR "Sending signal TERM to $appname\[$pid]\n";
            kill 'TERM', $pid;
            sleep 1;
            $action = 1;
        }
        elsif ($action == 1)
        {
            print STDERR "Sending signal KILL to $appname\[$pid]\n";
            kill 'KILL', $pid;
            sleep 1;
            $action = 2;
        }
        else
        {
            die "Could not kill $appname\[$pid].\n";            
        }

        $pid = pid_read;
    }
}




###########################
# Periodic tasks handling #
###########################

# Run the 'clean' action on every task
sub task_clean (\%)
{
    my $task = shift;
    
    foreach my $type (keys %$task)
    {
        $task->{$type}{'clean'}();
    }    
}

# Run every task periodically
sub task_run (\%)
{
    my $task = shift;

    while (1)
    {
        my $next = 1e10;
        
        foreach my $type (keys %$task)
        {
            next unless $task->{$type}{'active'};
            if ($task->{$type}{'next'} <= time)
            {
                $task->{$type}{'action'}();
                $task->{$type}{'next'} = time + $task->{$type}{'period'};
            }
            if ($task->{$type}{'next'} < $next)
            {
                $next = $task->{$type}{'next'}
            }
        }
        
        $next -= time;
        if ($next < 1) {$next = 1};
        sleep $next;
    }
}




#########
# GMail #
#########

# Clean output files
sub gmail_clean
{
    output "gmail", "status", "(not connected)\n";
    for (my $i = 0 ; $i < $conky{'GMail'}{'lines'} ; ++$i)
    {
        output "gmail", $i, "\n";
    }
}

# Fetch new mail data
sub gmail_getFeed
{
    my $auth = encode_base64($conky{"GMail"}{"user"}.":".$conky{"GMail"}{"pass"});
    my $ua = LWP::UserAgent->new;
    $ua->agent ($appname);
    
    my $req = HTTP::Request->new(GET => "https://mail.google.com/mail/feed/atom");
    $req->header("Authorization" => "Basic ".$auth);
    my $res = $ua->request($req);

    unless ($res->is_success)
    {
        print_log "WW: [GMail] HTTP error: ", $res->code, " ", $res->message, "\n";
        return -1;
    }

    my $test = $res->content;
    $test =~ s|<id>|<gid>|g;
    $test =~ s|</id>|</gid>|g;
    
    return XMLin ($test, "ForceArray" => ["entry"]);
}


# Main function
sub gmail_run
{
    my $xml = gmail_getFeed;

    if ($conky{"GMail"}{"user"})
    {
        output "gmail", "status", "(", $conky{"GMail"}{"user"}, "\@gmail.com)\n";
    }
        
    my $i = 0;
    if (ref $xml)
    {
        if ($xml->{'fullcount'} == 0)
        {
            output "gmail", $i, "No new mail\n";
            $i++;
        }
        for ( ;  $i < $xml->{'fullcount'}
              && $i < $conky{"GMail"}{"lines"} ; ++$i)
        {
	    my $title = $xml->{'entry'}[$i]{title};
	    if (ref($title))
	    {
		$title = "(no subject)";
	    }
            my $line = encode ("iso-8859-1", $title);
            $line = substr ($line, 0, $conky{"GMail"}{"chars"});
            output "gmail", $i, $line, "\n";
        }
    }
    else
    {
        output "gmail", $i, "Error\n";
        $i++;
    }

    for ( ; $i < $conky{"GMail"}{"lines"} ; ++$i)
    {
        output "gmail", $i, "\n";
    }
}




########
# GCal #
########

# Clean GCal output files
sub gcal_clean
{
    output "gcal", "status", "(not connected)\n";
    for (my $i = 0 ; $i < $conky{'GCal'}{'lines'} ; ++$i)
    {
        output "gcal", $i, "\n";
    }
}

# Parse ICal data
sub gcal_parse
{
    my $ical  = shift;
    my $block = shift;

    my $struct = {};
    $struct->{"type"} = $block if defined $block;

    while (<$ical>)
    {
        s/\r$//;
        if (m|^\s*END:$block\s*$|)
        {
            last;
        }
        if (m|^\s*BEGIN:(.*)\s*$|)
        {
            $struct->{"child"} = [] unless defined $struct->{"child"};
            push @{$struct->{"child"}}, gcal_parse ($ical, $1);
            next;
        }
        if (m|^\s*([^:]+):(.*)[\s\r^M]*$|i)
        {
            my $field = $1;
            my $value  = $2;
            $field =~ s/;.*$//;
            $struct->{$field} = encode ("iso-8859-1", decode ("utf-8", $value));
        }
    }

    return $struct;
}

# Get ICal events
sub gcal_getEvents
{
    my $ical = shift;
    my $events = shift;

    my $data = gcal_parse $ical;
    close $ical;
    
    my $vcalendar = $data->{'child'}[0];
    output "gcal", "status", "(", $vcalendar->{'X-WR-CALNAME'}, ")\n";
    
    foreach my $vevent (@{$vcalendar->{'child'}})
    {
	next unless $vevent->{"type"} eq "VEVENT";
	
	my $date = str2time $vevent->{"DTSTART"};
	my $summary = $vevent->{"SUMMARY"};
	$events->{$date} = $summary;
    }
    
    return $vcalendar->{'X-WR-CALNAME'};
}

# Main function
sub gcal_run
{
    my $i = 0;

    # Fetch ICal data
    my @results = ();
    for my $url (@{$conky{'GCal'}{'url'}})
    {
	my $ua  = LWP::UserAgent->new;
	my $req = HTTP::Request->new(GET => $url);
	my $res = $ua->request($req);
	unless ($res->is_success)
	{
	    print_log "WW: [GCal] HTTP error: ", $res->code, " ", $res->message, "\n";
	    output "gcal", $i, "Error\n";
	    ++$i;
	}
	push @results, $res;
    }

    if ($i == 0)
    {
	my $events = {};

        # Open ICal data as a file and parse it
	for my $res (@results)
	{
	    my $ical;
	    unless (open ($ical, "<", \$res->content))
	    {
		print_log "WW: [GCal] Could not open ICal content: $!\n";
		output "gcal", $i, "Error\n";
		++$i;
		last;
	    }

	    gcal_getEvents $ical, $events;
	}
        
        # Sort events and display
        my $now = time;
        foreach my $date (sort keys %$events)
        {
            next unless $date > $now;
            last unless $i < $conky{"GCal"}{"lines"};
            my $line = sprintf '${color1}%s ${color2}%s', time2str ("%d/%m %H:%M", $date), $events->{$date};
            output "gcal", $i, substr ($line, 0, $conky{"GCal"}{"chars"}), "\n";
            ++$i;
        }
    }

    # Clean remaining output files
    for ( ; $i < $conky{"GCal"}{"lines"} ; ++$i)
    {
        output "gcal", $i, "\n";
    }
}
